MacFormat 1995 June/MacFormat 25.iso/Shareware City/Developers/fortran-to-c-translator-11/Mac F2C 1.1/Test Project ƒ/test.f

Text File | 1995-01-28 | 4.9 KB | 193 lines | [TEXT/KAHL]

    Program test_f2c

c    This is a FORTRAN program to test Mac F2C v1.1

    character    junk*2

    write( 6, * ) '*****   Input/Output Test   *****'
    call i_o_test
    write(6,*) '\n*****   End of I/O test, hit return to continue...'
    read(5,99) junk
99    format( a1 )

    write( 6, *) '\n*****   Integer Math Test   *****'
    call int_test( 10 )
    write(6,*) '\n*****   End of integer math test, hit return to continue...'
    read(5,99) junk

    write( 6, * ) '\n*****   Floating Point Math Test   *****'
    call flt_test( 10 )
    write(6,*) '\n*****   End of floating point math test, hit return to continue...'
    read(5,99) junk

    write( 6, * ) '\n*****   Transcendental Function Test   *****'
    call trn_test
    write(6,*) '\n*****   End of transcendental function test, hit return to continue...'
    read(5,99) junk

    write(6,*) '##########################################################################'
    write(6,*) ' If you noticed that floating point values did not round correctly when'
    write(6,*) ' displayed, please read the enclosed file "If Floats Don\'t Display Right"'
    write(6,*) '##########################################################################'
    write( 6, * ) '\n*****   This completes all of the tests   *****'

    stop
    end



c************************************************************************
c
c    Subroutine to do the I/O tests
c
c************************************************************************

    subroutine  i_o_test
    dimension a(5), j(5)
    double precision  dx
    character text*40

c     Screen I/O tests

    write(6,*) '\nPart 1:  Screen I/O tests.\n\nEnter an integer value.'
    read(5,*) i
    write(6,*) 'The number you entered was:', i

    write(6,*) '\nEnter a single precision floating point value...'
    read(5,*) x
    write(6,*) 'The number you entered was: ', x

    write(6,*) '\nEnter a double precision floating point value...'
    read(5,*) dx
    write(6,*) 'The number you entered was: ', dx

    write(6,*) '\nEnter some text (40 char max)...'
    read(5,*) text
    write(6,*) 'The text you entered was: ', text

    write(6,*) '\nPart 2:  file I/O tests.  Hit return to continue...'
    read(5,399) text
399    format( a1 )

c     File I/O tests:  Store some values and write them to file

    do i = 1,5
      j(i) = i
      a(i) = dble(i)
    enddo
    text = 'A test message.'
    open(60,file='test.dat',form='unformatted')
    write(60) text, j, a
    close(60)

    write(6,*) 'Wrote the following data to file test.dat:\n'
    write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
304    format( 5x, a20, 5(i1, 2x), 5x, 5(f4.2, 2x) )

c Reset the variables and read them back

    do i = 1,5
      j(i) = 99
      a(i) = 99
    enddo
    text = 'reset'
    open(50,file='test.dat',form='unformatted')
    read(50) text, j, a
    close(50)

    write(6, *) '\nRead the following data from file test.dat:\n'
    write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)

    return
    end




c************************************************************************
c
c    Subroutine to do the integer math tests
c
c************************************************************************

    subroutine  int_test( m )
    write( 6, *) '\nGenerate a table of integers, squares, cubes, and their halves.\n'
    write(6, 203)
203    format( 10x, 'n', 5x, 'n^2', 5x, 'n^3', 5x, 'n/2', 3x, 'n^2/2', 3x, 'n^3/2' )
    do i = 1, m
        j = i**2
        k = i**3
        write( 6, 202 )  i, j, k, i/2, j/2, k/2
202        format( 5x, 6( i6, 2x ) )
    end do
    return
    end



c************************************************************************
c
c    Subroutine to do the floating point math tests
c
c************************************************************************

    subroutine  flt_test( m )
    write( 6, * ) '\nGenerate a table of floats, their squares, cubes, and their halves.\n'
    write(6, 205)
205    format( 12x, 'x', 6x, 'x^2', 6x, 'x^3', 6x, 'x/2', 4x, 'x^2/2', 4x, 'x^3/2' )
    do i = 1, m
        x1 = i*1.0
        x2 = x1**2
        x3 = x1**3
        write( 6, 201 )  x1, x2, x3, x1/2, x2/2, x3/2
201        format( 5x, 6( f8.2, 1x ) )
    end do
    return
    end




c************************************************************************
c
c    Subroutine to do the transcendental function tests
c
c************************************************************************

    subroutine  trn_test
    double precision  pi, x, s, c, s2, c2
    character junk*2

    pi = 3.141592653589793
    write( 6, * ) '\nPart 1: Trig Functions'
    write( 6, *) '\nGenerate a table of x, sin(x), cos(x) and the sum of their squares.\n'
    write(6, 207)
207    format( 9x, 'x', 10x, 'sin(x)', 8x, 'cos(x)', 3x, 'sin(x)^2 + cos(x)^2' )
    do i = 1, 12
        x = i * pi / 6.0
        s = dsin( x )
        c = dcos( x )
        s2 = s**2
        c2 = c**2
        write( 6, 200) i, s, c, s2 + c2
200        format( 5x, i2,'*pi/6' 3x, f11.8, 3x, f11.8, 3x, f15.10 )
    end do

    write(6,*) '\nPart 2:  Exponential functions; hit return to continue...'
    read(5,299) junk
299    format( a1 )

    write(6,*) 'Generate a table of x, log(x), and exp(log(x))\n'
    write(6, 208)
208    format( 11x, 'x', 16x, 'log(x)', 9x, 'exp(log(x))' )
    do i = 1, 10
        x = dble(i)
        s = dlog(x)
        c = dexp(s)
        write(6, 201) x, s, c
201        format( 5x, f13.10, 5x, f13.10, 5x, f13.10 )
    end do

    return
    end